Summary

Row

confirmed

12,011 (90.1%)

death

582 (4.8%)

Row

Daily cumulative cases by type (Denmark only)

Comparison

Column

Daily new cases

Cases distribution by type

Map

World map of cases

Forecasting Danish deaths

Row

ARIMA - AutoRegressive-Integrated-Moving-Average - for Danish deaths

Estimating R0

Row

Estimating Danish R0 using SIR model rougly equivalent to SSI / CDC estimates

Please note that the above graphs are adapted versions of estimates created by Mikkel Krogsholm.

About

The Coronavirus Dashboard: the case of Denmark

This Coronavirus dashboard: the case of Denmark provides an overview of the 2019 Novel Coronavirus COVID-19 (2019-nCoV) epidemic for Denmark. This dashboard is built with R using the R markdown-framework and was adapted from this dashboard by Rami Krispin.

The Dashboard has been further adapted per the dashboard developed by Antoine Soetewey.

The part on estimating R-naught/R0 is based on code from Mikkel Krogsholm.

Data
The input data for this dashboard is the dataset available from the {coronavirus} R package. Make sure to download the development version of the package to have the latest data:

install.packages("devtools")
devtools::install_github("RamiKrispin/coronavirus")

The data and dashboard is refreshed on an almost daily basis.

The raw data is pulled from the Johns Hopkins University Center for Systems Science and Engineering (JHU CCSE) Coronavirus repository.

Update
The data is as of 2020-06-04 and the dashboard has been updated on 2020-06-05 12:07:34.

---
title: "Coronavirus in Denmark"
author: "Tobias Søndergaard"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    # social: ["facebook", "twitter", "linkedin"]
    source_code: embed
    vertical_layout: fill
    
knit: (function(input_file, encoding) {
  out_dir <- 'docs';
  rmarkdown::render(input_file,
 encoding=encoding,
 output_file=file.path(dirname(input_file), out_dir, 'index.html'))})
    
---

```{r setup, include=FALSE}
#------------------ Packages ------------------
library(flexdashboard)
# install.packages("devtools")
#devtools::install_github("RamiKrispin/coronavirus", force = TRUE)
library(coronavirus)
data(coronavirus)
# View(coronavirus)
# max(coronavirus$date)
`%>%` <- magrittr::`%>%`
#------------------ Parameters ------------------
# Set colors
# https://www.w3.org/TR/css-color-3/#svg-color
confirmed_color <- "purple"
active_color <- "#1f77b4"
recovered_color <- "forestgreen"
death_color <- "red"
#------------------ Data ------------------
df <- coronavirus %>%
  # dplyr::filter(date == max(date)) %>%
  dplyr::filter(country == "Denmark") %>%
  dplyr::group_by(country, type) %>%
  dplyr::summarise(total = sum(cases)) %>%
  tidyr::pivot_wider(
    names_from = type,
    values_from = total
  ) %>%
  # dplyr::mutate(unrecovered = confirmed - ifelse(is.na(recovered), 0, recovered) - ifelse(is.na(death), 0, death)) %>%
  dplyr::mutate(unrecovered = confirmed - ifelse(is.na(death), 0, death)) %>%
  dplyr::arrange(-confirmed) %>%
  dplyr::ungroup() %>%
  dplyr::mutate(country = dplyr::if_else(country == "United Arab Emirates", "UAE", country)) %>%
  dplyr::mutate(country = dplyr::if_else(country == "Mainland China", "China", country)) %>%
  dplyr::mutate(country = dplyr::if_else(country == "North Macedonia", "N.Macedonia", country)) %>%
  dplyr::mutate(country = trimws(country)) %>%
  dplyr::mutate(country = factor(country, levels = country))
df_daily <- coronavirus %>%
  dplyr::filter(country == "Denmark") %>%
  dplyr::group_by(date, type) %>%
  dplyr::summarise(total = sum(cases, na.rm = TRUE)) %>%
  tidyr::pivot_wider(
    names_from = type,
    values_from = total
  ) %>%
  dplyr::arrange(date) %>%
  dplyr::ungroup() %>%
  #dplyr::mutate(active = confirmed - death - recovered) %>%
  dplyr::mutate(active = confirmed - death) %>%
  dplyr::mutate(
    confirmed_cum = cumsum(confirmed),
    death_cum = cumsum(death),
    recovered_cum = cumsum(recovered),
    active_cum = cumsum(active)
  )
df1 <- coronavirus %>% dplyr::filter(date == max(date))
df_daily <- df_daily[df_daily$date >= "2020-02-27",]
```

Summary
=======================================================================

Row {data-width=400}
-----------------------------------------------------------------------

### confirmed {.value-box}

```{r}
valueBox(
  value = paste(format(sum(df$confirmed), big.mark = ","), " (",
    round(100 * sum(df$recovered, na.rm = TRUE) / sum(df$confirmed), 1), "%)", sep = ""),
  caption = "Total confirmed cases (recovery rate)",
  icon = "fas fa-user-md",
  color = confirmed_color
)
```
















### death {.value-box}

```{r}
valueBox(
  value = paste(format(sum(df$death, na.rm = TRUE), big.mark = ","), " (",
    round(100 * sum(df$death, na.rm = TRUE) / sum(df$confirmed), 1),
    "%)",
    sep = ""
  ),
  caption = "Deaths (death rate)",
  icon = "fas fa-heart-broken",
  color = death_color
)
```


Row
-----------------------------------------------------------------------

### **Daily cumulative cases by type** (Denmark only)
    
```{r}
plotly::plot_ly(data = df_daily) %>%
  plotly::add_trace(
    x = ~date,
    # y = ~active_cum,
    y = ~confirmed_cum,
    type = "scatter",
    mode = "lines+markers",
    # name = "Active",
    name = "Confirmed",
    line = list(color = active_color),
    marker = list(color = active_color)
  ) %>%
  plotly::add_trace(
    x = ~date,
    # y = ~active_cum,
    y = ~recovered_cum,
    type = "scatter",
    mode = "lines+markers",
    # name = "Active",
    name = "Recovered",
    line = list(color = recovered_color),
    marker = list(color = recovered_color)
  ) %>%
  plotly::add_trace(
    x = ~date,
    y = ~death_cum,
    type = "scatter",
    mode = "lines+markers",
    name = "Dead",
    line = list(color = death_color),
    marker = list(color = death_color)
  ) %>%
  plotly::add_annotations(
    x = as.Date("2020-02-27"),
    y = 1,
    text = paste(
        "First case in DK",
        "
", "Feb 27th"), xref = "x", yref = "y", arrowhead = 5, arrowhead = 3, arrowsize = 1, showarrow = TRUE, ax = 0, ay = -90 ) %>% plotly::add_annotations( x = as.Date("2020-03-11"), y = 800, text = paste( "Covid-19 declared", "
", "a pandemic" ), xref = "x", yref = "y", arrowhead = 5, arrowhead = 3, arrowsize = 1, showarrow = TRUE, ax = 0, ay = -90 ) %>% plotly::add_annotations( x = as.Date("2020-03-17"), y = 1250, text = "Denmark is locked down", xref = "x", yref = "y", arrowhead = 5, arrowhead = 3, arrowsize = 1, showarrow = T, ax = 0, ay = -90 ) %>% plotly::add_annotations( x = as.Date("2020-04-01"), y = 14, text = paste( "SSI starts calculating", "
", "# of recovered" ), xref = "x", yref = "y", arrowhead = 5, arrowhead = 3, arrowsize = 1, showarrow = T, ax = 0, ay = 60 ) %>% plotly::add_annotations( x = as.Date("2020-04-14"), y = 14, text = "Denmark slowly reopens", xref = "x", yref = "y", arrowhead = 5, arrowhead = 3, arrowsize = 1, showarrow = T, ax = 0, ay = 60 ) %>% plotly::layout( title = "", yaxis = list(title = "Cumulative number of cases"), xaxis = list(title = "Date"), legend = list(x = 0.1, y = 0.9), hovermode = "compare" ) ``` Comparison ======================================================================= Column {data-width=400} ------------------------------------- ### **Daily new cases** ```{r} daily_confirmed <- coronavirus %>% dplyr::filter(type == "confirmed") %>% dplyr::filter(date >= "2020-02-27") %>% dplyr::mutate(country = country) %>% dplyr::group_by(date, country) %>% dplyr::summarise(total = sum(cases)) %>% dplyr::ungroup() %>% tidyr::pivot_wider(names_from = country, values_from = total) #---------------------------------------- # Plotting the data daily_confirmed %>% plotly::plot_ly() %>% plotly::add_trace( x = ~date, y = ~Denmark, type = "scatter", mode = "lines+markers", name = "Denmark" ) %>% plotly::add_trace( x = ~date, y = ~Norway, type = "scatter", mode = "lines+markers", name = "Norway" ) %>% plotly::add_trace( x = ~date, y = ~Sweden, type = "scatter", mode = "lines+markers", name = "Sweden" ) %>% plotly::add_trace( x = ~date, y = ~Finland, type = "scatter", mode = "lines+markers", name = "Finland" ) %>% plotly::layout( title = "", legend = list(x = 0.1, y = 0.9), yaxis = list(title = "Number of new confirmed cases"), xaxis = list(title = "Date"), # paper_bgcolor = "black", # plot_bgcolor = "black", # font = list(color = 'white'), hovermode = "compare", margin = list( # l = 60, # r = 40, b = 10, t = 10, pad = 2 ) ) ``` ### **Cases distribution by type** ```{r daily_summary} df_EU <- coronavirus %>% # dplyr::filter(date == max(date)) %>% dplyr::filter(country == "Denmark" | country == "Norway" | country == "Finland" | country == "Sweden") %>% dplyr::group_by(country, type) %>% dplyr::summarise(total = sum(cases)) %>% tidyr::pivot_wider( names_from = type, values_from = total ) %>% # dplyr::mutate(unrecovered = confirmed - ifelse(is.na(recovered), 0, recovered) - ifelse(is.na(death), 0, death)) %>% dplyr::mutate(unrecovered = confirmed - ifelse(is.na(death), 0, death)) %>% dplyr::arrange(confirmed) %>% dplyr::ungroup() %>% dplyr::mutate(country = dplyr::if_else(country == "United Arab Emirates", "UAE", country)) %>% dplyr::mutate(country = dplyr::if_else(country == "Mainland China", "China", country)) %>% dplyr::mutate(country = dplyr::if_else(country == "North Macedonia", "N.Macedonia", country)) %>% dplyr::mutate(country = trimws(country)) %>% dplyr::mutate(country = factor(country, levels = country)) plotly::plot_ly( data = df_EU, x = ~country, # y = ~unrecovered, y = ~ confirmed, # text = ~ confirmed, # textposition = 'auto', type = "bar", name = "Confirmed", marker = list(color = active_color) ) %>% plotly::add_trace( y = ~death, # text = ~ death, # textposition = 'auto', name = "Dead", marker = list(color = death_color) ) %>% plotly::layout( barmode = "stack", yaxis = list(title = "Total cases"), xaxis = list(title = ""), hovermode = "compare", margin = list( # l = 60, # r = 40, b = 10, t = 10, pad = 2 ) ) ``` Map ======================================================================= ### **World map of cases** ```{r} # map tab library(leaflet) library(leafpop) library(purrr) cv_data_for_plot <- coronavirus %>% # dplyr::filter(country == "Denmark") %>% dplyr::filter(cases > 0) %>% dplyr::group_by(country, lat, long, type) %>% dplyr::summarise(cases = sum(cases)) %>% dplyr::mutate(log_cases = 2 * log(cases)) %>% dplyr::ungroup() cv_data_for_plot.split <- cv_data_for_plot %>% split(cv_data_for_plot$type) pal <- colorFactor(c("orange", "red", "green"), domain = c("confirmed", "death", "recovered")) map_object <- leaflet() %>% addProviderTiles(providers$Stamen.Toner) names(cv_data_for_plot.split) %>% purrr::walk(function(df) { map_object <<- map_object %>% addCircleMarkers( data = cv_data_for_plot.split[[df]], lng = ~long, lat = ~lat, # label=~as.character(cases), color = ~ pal(type), stroke = FALSE, fillOpacity = 0.8, radius = ~log_cases, popup = leafpop::popupTable(cv_data_for_plot.split[[df]], feature.id = FALSE, row.numbers = FALSE, zcol = c("type", "cases", "country") ), group = df, # clusterOptions = markerClusterOptions(removeOutsideVisibleBounds = F), labelOptions = labelOptions( noHide = F, direction = "auto" ) ) }) map_object %>% addLayersControl( overlayGroups = names(cv_data_for_plot.split), options = layersControlOptions(collapsed = FALSE) ) ``` Forecasting Danish deaths ======================================================================= Row {data-width=400} ----------------------------------------------------------------------- ### **ARIMA - AutoRegressive-Integrated-Moving-Average - for Danish deaths** ```{r forecast} library(forecast) library(tidyverse) forecast_data <- df_daily# %>% slice(1:(n()-4)) min_data <- min(forecast_data$date) max_data <- max(forecast_data$date) forecast_length = 30 TS_data <- ts(forecast_data[,c(1,7)], frequency = 7) TS_fit <- auto.arima(TS_data[,2]) TS_fc <- forecast(TS_fit, h=forecast_length) fore.dates <- seq.Date(from = max_data+1, to = max_data+forecast_length, by="days") plot_daily <- forecast_data[forecast_data$date >= "2020-02-27",] TS_fc$mean <- round(TS_fc$mean, digits=0) TS_fc$upper <- round(TS_fc$upper, digits=0) TS_fc$lower <- round(TS_fc$lower, digits=0) td <- plot_daily$death_cum[nrow(plot_daily)] TS_fc$lower[TS_fc$lower% plotly::add_lines(x = plot_daily$date, y = plot_daily$death_cum, color = I("black"), name = "Observed deaths", marker=list(mode='lines')) %>% plotly::add_lines(x = fore.dates, y = TS_fc$mean, color = I("blue"), name = "Predicted deaths") %>% plotly::add_ribbons(x = fore.dates, ymin = TS_fc$lower[, 2], ymax = TS_fc$upper[, 2], color = I("gray95"), name = "95% confidence") %>% plotly::add_ribbons(x = fore.dates, ymin = TS_fc$lower[, 1], ymax = TS_fc$upper[, 1], color = I("gray80"), name = "80% confidence") %>% layout(annotations = list(x = 0.40, y = 0.90, text = paste("AIC:",TS_fit$aic, "| Log-Likelihood:", TS_fit$loglik, sep = " "), showarrow = F, xref='paper', yref='paper', xanchor='right', yanchor='auto', xshift=0, yshift=-14, font=list(size=10, color="black")) ) ``` Estimating R0 ======================================================================= Row {data-width=400} ----------------------------------------------------------------------- ### **Estimating Danish R0 using SIR model rougly equivalent to SSI / CDC estimates** ```{r} library(tidyverse) library(EpiEstim) library(plotly) url <- "https://api.covid19data.dk/ssi_newly_hospitalized" hosp_raw <- jsonlite::fromJSON(url) hosp_raw <- hosp_raw %>% as_tibble() %>% mutate(date = date %>% lubridate::ymd_hms() %>% as.Date()) ads <- hosp_raw %>% mutate(rollingmean = c(rep(NA, 3), # Adding a rolling mean zoo::rollmean(x = newly_hospitalized, k = 7), rep(NA, 3))) #slice(1:(n()-4)) %>% # remove last four entries ## Choosing parameters for estimating R ######################################## # We need to supply the estimate_R function with some parameters in order for it # to estimate R. We will use two sets of parameters: # 1) from the CDC where they have estimated mean and the standard deviation for # the serial interval. # 2) Numbers I have learned that the danish SSI uses. I have only mean informed # of their mean, so the standard deviation I have chosen to be the same as # the mean. This number can be changed as we get more info from SSI. # CDC # https://wwwnc.cdc.gov/eid/article/26/6/20-0357_article cdc_mean_si = 3.96 cdc_std_si = 4.75 # SSI - kan arbejde med 5-6 (jf. WHO p. 2: https://www.who.int/docs/default-source/coronaviruse/situation-reports/20200306-sitrep-46-covid-19.pdf?sfvrsn=96b04adf_4) ssi_mean_si = 4.7 ssi_std_si = 4.7 confirmed_cases <- ads %>% drop_na() %>% select(I = rollingmean) cdc_R <- estimate_R(confirmed_cases, method = "parametric_si", config = make_config(list(mean_si = cdc_mean_si, std_si = cdc_std_si))) ssi_R <- estimate_R(confirmed_cases, method = "parametric_si", config = make_config(list(mean_si = ssi_mean_si, std_si = ssi_std_si))) cdc_pd <- cdc_R$R %>% as_tibble() %>% select(t = t_end, R0 = `Mean(R)`, lower = `Quantile.0.05(R)`, upper = `Quantile.0.95(R)`) %>% mutate(source = "cdc") ssi_pd <- ssi_R$R %>% as_tibble() %>% select(t = t_end, R0 = `Mean(R)`, lower = `Quantile.0.05(R)`, upper = `Quantile.0.95(R)`) %>% mutate(source = "ssi") pd <- bind_rows(cdc_pd, ssi_pd) %>% mutate(t = (t-1) + as.Date("2020-02-28")) pd$Date <- pd$t facetlabs <- c(cdc = "Danish R0 using Center for Disease Control inputs", ssi = "Danish R0 using Statens Serum Institut inputs") p1 <- ggplot(pd) + geom_ribbon(aes(x = Date, ymin = lower, ymax = upper), fill = "lightgrey") + geom_line(aes(x = Date, y = R0)) + geom_hline(yintercept = 1, linetype = "dashed") + facet_wrap(~ source, ncol = 1, labeller = labeller(source = facetlabs)) + theme_minimal() + labs(x = "", y = "") + scale_x_date(breaks = "weeks", labels = scales::date_format("%d-%m")) ggplotly(p1) ``` Please note that the above graphs are adapted versions of estimates created by [Mikkel Krogsholm](https://gist.github.com/mikkelkrogsholm/df208ab854e3c13ab07d23c027af7b5b). About ======================================================================= **The Coronavirus Dashboard: the case of Denmark** This Coronavirus dashboard: the case of Denmark provides an overview of the 2019 Novel Coronavirus COVID-19 (2019-nCoV) epidemic for Denmark. This dashboard is built with R using the R markdown-framework and was adapted from this [dashboard](https://ramikrispin.github.io/coronavirus_dashboard/){target="_blank"} by Rami Krispin.
The Dashboard has been further adapted per the dashboard developed by [Antoine Soetewey](https://github.com/AntoineSoetewey).
The part on estimating R-naught/R0 is based on code from [Mikkel Krogsholm](https://gist.github.com/mikkelkrogsholm/df208ab854e3c13ab07d23c027af7b5b). **Data**
The input data for this dashboard is the dataset available from the [`{coronavirus}`](https://github.com/RamiKrispin/coronavirus){target="_blank"} R package. Make sure to download the development version of the package to have the latest data: ``` install.packages("devtools") devtools::install_github("RamiKrispin/coronavirus") ``` The data and dashboard is refreshed on an almost daily basis. The raw data is pulled from the Johns Hopkins University Center for Systems Science and Engineering (JHU CCSE) Coronavirus [repository](https://github.com/RamiKrispin/coronavirus-csv){target="_blank"}. **Update**
The data is as of `r format(max(coronavirus$date))` and the dashboard has been updated on `r format(Sys.time())`.